library(tm) # przetwarzanie tekstu
## Ładowanie wymaganego pakietu: NLP
library(SnowballC) # stemming słów
library(Matrix) # macierze rzadkie
library(dplyr) # manipulacja danymi
## 
## Dołączanie pakietu: 'dplyr'
## Następujące obiekty zostały zakryte z 'package:stats':
## 
##     filter, lag
## Następujące obiekty zostały zakryte z 'package:base':
## 
##     intersect, setdiff, setequal, union
library(ClusterR) # klasteryzacja
library(plotly) # wizualizacja
## Ładowanie wymaganego pakietu: ggplot2
## 
## Dołączanie pakietu: 'ggplot2'
## Następujący obiekt został zakryty z 'package:NLP':
## 
##     annotate
## 
## Dołączanie pakietu: 'plotly'
## Następujący obiekt został zakryty z 'package:ggplot2':
## 
##     last_plot
## Następujący obiekt został zakryty z 'package:stats':
## 
##     filter
## Następujący obiekt został zakryty z 'package:graphics':
## 
##     layout
data <- read.csv('wikipedia.csv', row.names = "X") # wczytanie pliku CSV z danymi
#head(data) # podgląd pierwszych wierszy
#str(data) # struktura danych
#colnames(data) # nazwy kolumn
#dim(data) # wymiary danych
#head(data$summary)
set.seed(123)
x <- sample(nrow(data), 6000) # losowa próbka 6000 wierszy, niestety redukacja było potrzebna z powodu niewystarczającej ilości RAM
data <- data[x, ]
nrow(data) # sprawdzenie liczby obserwacji
## [1] 6000
corpus <- VCorpus(VectorSource(data$summary)) %>%
tm_map(content_transformer(tolower)) %>% # małe litery
tm_map(removeNumbers) %>% # usunięcie cyfr
tm_map(removePunctuation) %>% # usunięcie interpunkcji
tm_map(removeWords, stopwords()) %>% # usunięcie stopwords
tm_map(content_transformer(function(x){
x <- gsub('\n', ' ', x) # usunięcie znaków nowej linii
x <- gsub('\\n', ' ', x)
x
})) %>%
tm_map(stemDocument) %>% # stemming
tm_map(stripWhitespace) # usunięcie nadmiarowych spacji

dtm <- DocumentTermMatrix(corpus) # macierz dokument-słowo
rm(corpus) # zwalnianie pamięci

dtm_sparse <- sparseMatrix(
i = dtm$i,
j = dtm$j,
x = as.numeric(dtm$v > 0),
dims = c(dtm$nrow, dtm$ncol),
dimnames = dimnames(dtm)
)
rm(dtm)

word_count <- colSums(dtm_sparse)
freq_words <- names(word_count[word_count >= 5])
dtm_sparse <- dtm_sparse[, freq_words]
corpus_title <- VCorpus(VectorSource(data$title)) %>%
tm_map(stemDocument) %>%
tm_map(stripWhitespace)

dtm_title <- DocumentTermMatrix(corpus_title)
rm(corpus_title)

dtm_title_sparse <- sparseMatrix(
i = dtm_title$i,
j = dtm_title$j,
x = as.numeric(dtm_title$v > 0),
dims = c(dtm_title$nrow, dtm_title$ncol),
dimnames = dimnames(dtm_title)
)
rm(dtm_title)

colnames(dtm_title_sparse) <- paste("title", colnames(dtm_title_sparse), sep='_')

dtm_combined <- cbind(dtm_sparse, dtm_title_sparse)
rm(dtm_sparse, dtm_title_sparse)
# na początekwybierzemy taką liczbę klastrów, gdyż tyle mamy naturalnie kategorii w danych
k <- 6
set.seed(123)
km_result <- kmeans(dtm_combined, centers = k)
## Warning in asMethod(object): sparse->dense coercion: allocating vector of size
## 1.3 GiB
km_result$size # liczność klastrów
## [1]  918  797  389  128 3437  331
km_result$tot.withinss # suma wariancji wewnątrzklastrowych
## [1] 1152820
wiki_stopwords <- c(
"state","found","call","end","mani","world","continu",
"howev","make","given","known","name","term","often",
"common","gener","well","later","earli",
"can","may","two","three","first","second","one",
"differ","relat","follow","form","case",
"refer","also","see","use","includ","exampl","general",
"therefor","thus",
"publish","public","book","studi","work","author",
"research","paper","journal"
)

dtm_filtered <- dtm_combined[, !colnames(dtm_combined) %in% wiki_stopwords]
km_result_filtered <- kmeans(dtm_filtered, centers = k)
## Warning in asMethod(object): sparse->dense coercion: allocating vector of size
## 1.3 GiB
km_result_filtered$size
## [1]  111 3553  361  893  314  768
km_result_filtered$tot.withinss
## [1] 1110474
wcss_1 <- km_result_filtered$tot.withinss
# tutaj spróbujemy puścić klasteryzację dla innych wartości parametru k 2,3,4,5, 7, 8, 9 


km_2 <- kmeans(dtm_filtered, centers = 2)
## Warning in asMethod(object): sparse->dense coercion: allocating vector of size
## 1.3 GiB
wcss_2 <- km_2$tot.withinss

set.seed(123)
km_3 <- kmeans(dtm_filtered, centers = 3)
## Warning in asMethod(object): sparse->dense coercion: allocating vector of size
## 1.3 GiB
wcss_3 <- km_3$tot.withinss

set.seed(123)
km_4 <- kmeans(dtm_filtered, centers = 4)
## Warning in asMethod(object): sparse->dense coercion: allocating vector of size
## 1.3 GiB
wcss_4 <- km_4$tot.withinss

set.seed(123)
km_5 <- kmeans(dtm_filtered, centers = 5)
## Warning in asMethod(object): sparse->dense coercion: allocating vector of size
## 1.3 GiB
wcss_5 <- km_5$tot.withinss

# dla lepszego efektu spróbujemy puścić jeszcze dla k = 7, 8, 9 jeżeli się uda

set.seed(123)
km_7 <- kmeans(dtm_filtered, centers = 7)
## Warning in asMethod(object): sparse->dense coercion: allocating vector of size
## 1.3 GiB
wcss_7 <- km_7$tot.withinss

set.seed(123)
km_8 <- kmeans(dtm_filtered, centers = 8)
## Warning in asMethod(object): sparse->dense coercion: allocating vector of size
## 1.3 GiB
## Warning: 'medpolish()' nie zbiegł się w 10 iteracjach
wcss_8 <- km_8$tot.withinss

set.seed(123)
km_9 <- kmeans(dtm_filtered, centers = 9)
## Warning in asMethod(object): sparse->dense coercion: allocating vector of size
## 1.3 GiB
## Warning in asMethod(object): 'medpolish()' nie zbiegł się w 10 iteracjach
wcss_9 <- km_9$tot.withinss
# wykres homogeniczność wewnątrz klastrów, na jego podstawie spróbujemy znaleźć punkt łokcia i dobrać odpowiednią liczbę klastrów

results_manual <- data.frame(
  k = c(2, 3, 4, 5, 6, 7, 8, 9),
  WCSS = c(wcss_2, wcss_3, wcss_4, wcss_5, wcss_1, wcss_7, wcss_8, wcss_9)
)

results_manual
##   k    WCSS
## 1 2 1167102
## 2 3 1140548
## 3 4 1126545
## 4 5 1117117
## 5 6 1110474
## 6 7 1105696
## 7 8 1102046
## 8 9 1097683
p_wcss <- plot_ly(
  results_manual,
  x = ~k,
  y = ~WCSS,
  type = "scatter",
  mode = "lines+markers"
) %>%
  layout(
    title = "Elbow method – homogeniczność (WCSS)",
    xaxis = list(title = "Liczba klastrów (k)"),
    yaxis = list(title = "WCSS"),
    margin = list(
      l = 80,   # left
      r = 40,   # right
      b = 80,   # bottom
      t = 80    # top
  )
  )

p_wcss
 # z wykresu możemy zauważyć, że najmniejsza wartość, począwszy od której mamy minimalna zmniejszanie wartości to k = 5  lub 4 i tym wartością  się też się przyjżymy
# analiza dla k = 4
km_4$size
## [1]  810 4246  699  245
km_4$centers[, 1:10]
##             −⁠⁠        –cite    –present          ———         ’ve          ···
## 1 0.007407407 0.0024691358 0.002469136 0.0000000000 0.000000000 0.0061728395
## 2 0.000000000 0.0009420631 0.004003768 0.0007065473 0.000000000 0.0002355158
## 3 0.000000000 0.0000000000 0.028612303 0.0028612303 0.004291845 0.0000000000
## 4 0.000000000 0.0000000000 0.036734694 0.0000000000 0.008163265 0.0000000000
##           aaa     aaaldot          aab      aacdot
## 1 0.008641975 0.008641975 0.0024691358 0.009876543
## 2 0.002826189 0.000000000 0.0007065473 0.000000000
## 3 0.008583691 0.000000000 0.0000000000 0.000000000
## 4 0.008163265 0.000000000 0.0000000000 0.000000000
# coś co być może pomoże nam zobaczyć jakie słowa są charakterystyczne dla danych klastrów

get_top_words_contrastive <- function(dtm, km, cluster_id, top_n = 10) {
  
  in_cluster  <- km$cluster == cluster_id
  out_cluster <- km$cluster != cluster_id
  
  mu_in  <- colMeans(dtm[in_cluster, , drop = FALSE])
  mu_out <- colMeans(dtm[out_cluster, , drop = FALSE])
  
  score <- mu_in - mu_out
  score <- sort(score, decreasing = TRUE)
  
  head(score, top_n)
}

for (k in 1:4) {
  cat("\n====================\n")
  cat("CLUSTER", k, "\n")
  print(get_top_words_contrastive(dtm_filtered, km_4, k, 10))
}
## 
## ====================
## CLUSTER 1 
## displaystyl      result       defin        valu    function      consid 
##   0.6095625   0.5551060   0.5549632   0.5455506   0.5289231   0.5077428 
##         set     possibl      requir        mean 
##   0.4933205   0.4924570   0.4881610   0.4840505 
## 
## ====================
## CLUSTER 2 
##    title_list           phd    postdoctor    peerreview  title_physic 
##   0.028065049   0.017462005   0.011566054   0.011367866   0.010412913 
##   title_prize title_societi     title_for         sloan editorinchief 
##   0.008850506   0.008652318   0.008603442   0.007958661   0.007562285 
## 
## ====================
## CLUSTER 3 
##      year       new   histori      time      part     peopl   centuri      made 
## 0.5445883 0.5032138 0.4784991 0.4716164 0.4415217 0.4381828 0.4366121 0.4282349 
##    nation    cultur 
## 0.4198228 0.3896819 
## 
## ====================
## CLUSTER 4 
##       led     place     major     peopl      much      caus     great      even 
## 0.7598362 0.7585844 0.7583468 0.7508715 0.7452189 0.7345520 0.7330768 0.7297434 
##    remain     sever 
## 0.7276760 0.7259916
# to co otrzymaliśmy jest dosyć charakterystyczne dla klastrów chociażby dla klastra 2 słoa sugerują raczej na tematykę matematyczną, funkcja, consider, define, depend i tak dalej dla klastra 3 mamy coś co sugerowałoby na histoię matematyki i fizyki jakiś wielkich umysłów, a słowa dla klastra numer 4 sugerują tematykę historyczną
# anlogicznie przeanalizujemy dla k = 5

for (k in 1:5) {
  cat("\n====================\n")
  cat("CLUSTER", k, "\n")
  print(get_top_words_contrastive(dtm_filtered, km_5, k, 10))
}
## 
## ====================
## CLUSTER 1 
## displaystyl       defin    function      result        valu         set 
##   0.5533400   0.4156151   0.3837161   0.3556313   0.3518177   0.3503904 
##      number       equat        frac    properti 
##   0.3189163   0.3138446   0.3136912   0.3083487 
## 
## ====================
## CLUSTER 2 
##      year       new   histori      time     peopl      part   centuri      made 
## 0.5456224 0.5005224 0.4839423 0.4710577 0.4594601 0.4378231 0.4356537 0.4353525 
##    nation    cultur 
## 0.4306067 0.4031504 
## 
## ====================
## CLUSTER 3 
##    result    requir   possibl   similar    depend      show    consid       way 
## 0.6504459 0.6354167 0.6290346 0.6139869 0.6118749 0.6093837 0.6074323 0.6056629 
##      mean     anoth 
## 0.6024759 0.6021247 
## 
## ====================
## CLUSTER 4 
##     peopl       led     major     place     began     great      caus     claim 
## 0.7842100 0.7779170 0.7661904 0.7598602 0.7573243 0.7561468 0.7533815 0.7462438 
##       day      came 
## 0.7450469 0.7384147 
## 
## ====================
## CLUSTER 5 
##           phd    title_list    peerreview    postdoctor         award 
##   0.032551679   0.027699608   0.015454077   0.013882574   0.012194876 
##  title_physic title_societi   title_prize editorinchief       homepag 
##   0.010281032   0.010149473   0.010018394   0.009429981   0.008775308
# możemy zauważyć, że słownictwo dla klastra 1 jest dosyć typowo naukowe dla nauk ściłśych jak fizyka czy matematyka
# klaster 2 charakteryzuje się słownictwem tytułów nauków więc może coś o dziennikach oraz biografii matematyków, fizyków ich historia
# w klastrze 3 mamy typowe słownictwo dla historii społeczeństwa i kultury, przywództwa
# klaster 4 słownictwo typowo matematyczne
# klaster 5 być może dotyczy opisów historycznych, społecznyc i geogradficznych

# co w miarę pokrywa się z naszymi kategoriami